home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Delphi Informant Complete 1995 - 2000
/
Delphi Informant Complete 1995 to 2000.iso
/
Delphi Informant Magazine Complete Works SOURCE CODE 1998.rar
/
1998
/
Feb
/
di9802ts
/
ScriptSite.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1997-08-27
|
5KB
|
156 lines
{ This implements the required IActiveScriptSite Interface }
unit ScriptSite;
interface
Uses Windows, SysUtils, comobj, activeX, Activscp, Dialogs, Forms, ComServ,
Demo_TLB;
Type
{ TActiveScriptSite Declaration }
TActiveScriptSite = class(TComObject, IActiveScriptSite,
IActiveScriptSiteWindow)
protected
{ IActiveScriptSite }
function GetLCID(var wLCID: TLCID): HResult; virtual; stdcall;
function GetDocVersionString(var VersionString: TBSTR): HResult; virtual; stdcall;
function GetItemInfo(ItemName: WideString; dwReturnMask: DWord;
out UnkItem: IUnknown; out TypeInfo: ITypeInfo): HResult; virtual; stdcall;
function OnScriptTerminate(var VarResult: OleVariant;
var ExcepInfo: TExcepInfo): HResult; virtual; stdcall;
function OnStateChange(ScriptState: LongInt): HResult; virtual; stdcall;
function OnScriptError(pAse: IActiveScriptError): HResult; virtual; stdcall;
function OnEnterScript: HResult; virtual; stdcall;
function OnLeaveScript: HResult; virtual; stdcall;
{ IActiveScriptSiteWindow }
function GetWindow(var Hwnd: THandle): HResult; stdcall;
function EnableModeless(FEnable: WordBool): HResult; stdcall;
end;
implementation
{ TActiveScriptSite - Protected Implementation }
function TActiveScriptSite.GetLCID(var wLCID: TLCID): HResult;
begin
{ No need for us to do anything here. }
Result := S_OK;
end;
function TActiveScriptSite.GetItemInfo(ItemName: WideString; dwReturnMask: DWord;
out UnkItem: IUnknown; out TypeInfo: ITypeInfo): HResult;
var
ObjDispatch : IDispatch;
begin
{ This method is called when the engine wants information about an object
that we submitted by calling AddNamedItem. Using Delphi 3, the instances
created here will free when they go out of context. }
{ Does the engine want the Automation Object's IUnknown Pointer? }
if (dwReturnMask = SCRIPTINFO_IUNKNOWN) and (ItemName = 'MyObj') then
UnkItem := CoMyObj.Create;
{ Does the engine want the Automation Object's type information? }
if (dwReturnMask = SCRIPTINFO_ITYPEINFO) and (ItemName = 'MyObj') then
begin
ObjDispatch := CoMyObj.Create;
{ Get a handle to our Automation Object's Type Library }
ObjDispatch.GetTypeInfo(0,0,TypeInfo);
end;
Result := S_OK;
end;
function TActiveScriptSite.GetDocVersionString(var VersionString: TBSTR): HResult;
begin
{ Tell engine that we will accept it's default. ie. not implemented }
Result := E_NOTIMPL;
end;
function TActiveScriptSite.OnScriptTerminate(var VarResult: OleVariant;
var ExcepInfo: TExcepInfo): HResult;
begin
{ This tells us that the script is completed }
Result := S_OK;
end;
function TActiveScriptSite.OnStateChange(ScriptState: LongInt): HResult;
begin
{ Alerts us when engine states are changing }
Result := S_OK;
end;
function TActiveScriptSite.OnScriptError(pAse: IActiveScriptError): HResult;
var
wCookie: Word;
ErrString: String;
ExcepInfo: TExcepInfo;
CharNo: LongInt;
LineNo: LongInt;
begin
wCookie := 0;
LineNo := 0;
CharNo := 0;
if Assigned(pAse) then begin
pAse.GetExceptionInfo(ExcepInfo);
pAse.GetSourcePosition(wCookie, LineNo, CharNo);
ErrString := concat(ExcepInfo.bstrSource, ' ',
ExcepInfo.bstrDescription, ' ',
'Line ', intToStr(LineNo),
'. Column ', intToStr(CharNo));
ShowMessage(ErrString);
end;
pase := nil;
result := E_FAIL; { Halt script execution! }
end;
function TActiveScriptSite.OnEnterScript(): HResult;
begin
Result := S_OK;
end;
function TActiveScriptSite.OnLeaveScript(): HResult;
begin
Result := S_OK;
end;
{ IActiveScriptSite Window Implementation }
function TActiveScriptSite.GetWindow(var Hwnd: THandle): HResult;
begin
{ ActiveX Scripting uses this to get a window handle from our application.
This allows the script engine to display information on the interface, such
as a dialog box.}
Hwnd := Application.Handle;
Result := S_OK;
end;
function TActiveScriptSite.EnableModeless(FEnable: WordBool): HResult;
begin
{ Causes the host to enable or disable its main window as well as any
modeless dialog boxes. We won't need this for our demo }
Result := S_OK;
end;
Initialization
TComObjectFactory.Create(ComServer, TActiveScriptSite, IID_IActiveScriptSite,
'ActiveScript Host', '',ciMultiInstance);
end.